home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / htmlElems.tcl < prev    next >
Text File  |  1997-09-22  |  40KB  |  1,364 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlElems.tcl"
  6.  #                                    created: 96-04-29 21.31.14 
  7.  #                                last update: 97-09-16 22.08.37 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlElems.tcl {} {}
  25.  
  26. #
  27. # <P>
  28. #
  29.  
  30. proc htmlElemParagraph {{attr ""}} {
  31.     global HTMLmodeVars
  32.     if {$HTMLmodeVars(pIsContainer)} { 
  33.         htmlTag "htmlBuildCR2Elem P $attr"
  34.     } else {
  35.         htmlTag "htmlBuildOpening P 1 1 $attr"
  36.     }
  37. }
  38.  
  39.  
  40. # Insert a <BR> in the end of every line in selection.
  41.  
  42. proc htmlInsertLineBreaks {} {
  43.     if {![isSelection]} {
  44.         beep
  45.         message "No selection."
  46.         return
  47.     }
  48.     
  49.     regsub -all "\r" [getSelect] "[htmlSetCase <BR>]\r" text
  50.     replaceText [getPos] [selEnd] $text
  51. }
  52.  
  53. # Remove all <BR> in selection.
  54. proc htmlRemoveLineBreaks {} {
  55.     if {![isSelection]} {
  56.         beep
  57.         message "No selection."
  58.         return
  59.     }
  60.     
  61.     regsub -all -nocase "<BR(\[ \t\r\]+\[^<>\]*>|>)" [getSelect] "" text
  62.     if {$text != [getSelect]} {
  63.         replaceText [getPos] [selEnd] $text
  64.     }
  65. }
  66.  
  67. # Insert <P> at empty lines in selection, and in the beginning of the selection.
  68. # Several empty lines are contracted to one.
  69. proc htmlInsertParagraphs {} {
  70.     global HTMLmodeVars
  71.     if {![isSelection]} {
  72.         beep
  73.         message "No selection."
  74.         return
  75.     }
  76.     set pIsContainer $HTMLmodeVars(pIsContainer)
  77.     
  78.     if {[set oelem [htmlOpenElem P "" 0]] == ""} {return}
  79.     set pind [set indent [htmlFindNextIndent]]
  80.     if {$HTMLmodeVars(indentP)} {append pind \t}
  81.     set text "$indent\r$indent$oelem\r"
  82.     set prevLineEmpty 1
  83.     
  84.     foreach ln [split [string trimright [string trimleft [getSelect] "\r"]] "\r"] {
  85.         regexp {[ \t]*} $ln lntest
  86.         # Only add <P> if previous line was not empty.
  87.         if {$ln == $lntest && !$prevLineEmpty} {
  88.             set prevLineEmpty 1
  89.             if {$pIsContainer} {
  90.                 append text "$indent[htmlCloseElem P]\r$indent\r$indent$oelem\r"
  91.             } else {
  92.                 append text "\r$indent$oelem\r"
  93.             }
  94.         } else {
  95.             # Skip an empty line which follows another empty line.
  96.             if {$ln != $lntest} {
  97.                 set prevLineEmpty 0
  98.                 append text "$pind[string trim $ln]\r"
  99.             }
  100.         }
  101.     }
  102.     if {$pIsContainer} {
  103.         append text "$indent[htmlCloseElem P][htmlCloseCR2 $indent [selEnd]]"
  104.     }
  105.     
  106.     replaceText [getPos] [selEnd] $text
  107. }
  108.  
  109.  
  110. # Ask for input how to build a list. Returns "number of items" and
  111. # "ask for list item attributes". Returns "" if canceled or any problem.
  112. proc htmlListQuestions {ltype liattr lipr} {
  113.     global HTMLmodeVars
  114.     
  115.     set promptNoisily $HTMLmodeVars(promptNoisily)
  116.     if {[string length $liattr]} {
  117.         set optatts [htmlGetOptional $liattr]
  118.         set usedatts [htmlGetUsed $liattr]
  119.         set askForMore [htmlGetAttrMore $liattr]
  120.     } else {
  121.         set optatts ""
  122.         set askForMore [htmlGetAttrMore LI]
  123.         set usedatts [htmlGetUsed LI]
  124.     }
  125.     if {$lipr != "LI"} { 
  126.         set optatts [concat $optatts [htmlGetOptional DD]]
  127.         set usedatts [concat $usedatts [htmlGetUsed DD]]
  128.         if {!$askForMore} {set askForMore [htmlGetAttrMore DD]}
  129.     }
  130.     if {$HTMLmodeVars(useBigWindows)} {
  131.         set it {0 0 3 0}
  132.         while {1} {
  133.             set txt "dialog -w 280 -h 130 -b OK 20 100 75 120 -b Cancel 110 100 165 120 \
  134.             -t {$ltype list} 100 10 250 30 \
  135.             -t {How many items?} 10 40 150 60 -e [list [lindex $it 2]] 160 40 180 55"
  136.             if {(!$HTMLmodeVars(useAttsApplyToDialogs) && [llength $optatts]) || [llength $usedatts]} {
  137.                 append txt " -c {Ask for attributes for each $lipr} [lindex $it 3] \
  138.                 10 70 330 85"
  139.             }
  140.             set it [eval $txt]
  141.             if {[lindex $it 1]} {return}
  142.             set items [lindex $it 2]
  143.             if {[llength $it] == 4 && [lindex $it 3]} {
  144.                 set askForLiAttr 1
  145.             } else {
  146.                 set askForLiAttr 0
  147.             }
  148.             
  149.             if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
  150.                 alertnote "Invalid input: non-negative integer required"
  151.             } elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
  152.                 alertnote "Invalid input: positive integer required"
  153.             } else {
  154.                 break
  155.             }
  156.         }
  157.     } else {
  158.         if {$promptNoisily} {beep}    
  159.         while {[catch {statusPrompt "$ltype list: How many items? " htmlNumberStatusFunc} items]} {
  160.             if {$items == "Cancel all!"} {message "Cancel"; return}
  161.         }
  162.         if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
  163.             beep; message "Invalid input: non-negative integer required."; return
  164.         } elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
  165.             beep; message "Invalid input: positive integer required."; return
  166.         }
  167.         if {[llength $usedatts] && $items} {
  168.             if {$promptNoisily} {beep}    
  169.             while {[catch {statusPrompt "Ask for attributes for each $lipr? \[n\] " \
  170.             htmlStatusAskYesOrNo} v]} {
  171.                 if {$v == "Cancel all!"} {message "Cancel"; return}
  172.             }
  173.             if {$v == "yes"} {
  174.                 set askForLiAttr 1
  175.             } else {
  176.                 set askForLiAttr 0
  177.             }
  178.         } else {
  179.             set askForLiAttr 0
  180.         }
  181.     }
  182.     return [list $items $askForLiAttr]
  183. }
  184.     
  185.  
  186. # Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
  187. # insertion point there.  If anything is selected, makes it the first item.
  188. proc htmlBuildList {ltype {liattr ""} {listattr ""}} {
  189.     global HTMLmodeVars 
  190.     global htmlCurSel
  191.     global htmlIsSel
  192.     # Discursive list?
  193.     if {$ltype == "DL"} {htmlDiscursive; return}
  194.     
  195.     set useTabMarks $HTMLmodeVars(useTabMarks)
  196.     set containers $HTMLmodeVars(lidtAreContainers)
  197.     
  198.     set listStr [htmlListQuestions $ltype $liattr LI]
  199.     if {![llength $listStr]} {
  200.         return
  201.     } else {
  202.         set items [lindex $listStr 0]
  203.         set askForLiAttr [lindex $listStr 1]
  204.     }
  205.  
  206.     # If zero list items, just make an htmlBuildCR2Elem
  207.     if {$items == 0} {
  208.         htmlBuildCR2Elem $ltype $listattr
  209.         return
  210.     }
  211.     
  212.     htmlGetSel
  213.     set sel $htmlCurSel
  214.     set exind ""
  215.     if {$HTMLmodeVars(indent${ltype})} {
  216.         set exind \t
  217.         regsub -all "\r" $sel "\r\t" sel
  218.     }
  219.     set IsSel $htmlIsSel
  220.     set indent [htmlFindNextIndent]
  221.     set text [htmlOpenCR $indent 1]
  222.     if {$containers} {
  223.         if {[set text1 "[htmlOpenElem $ltype $listattr 0]\r"] == "\r"} {return}
  224.         append text $text1
  225.         if {$askForLiAttr} {
  226.             set text1 [htmlOpenElem LI $liattr 0]
  227.         } else {
  228.             set text1 [htmlSetCase <LI>]
  229.         }
  230.         if {$text1 == ""} {return}
  231.         append text $indent $exind $text1
  232.         if {$IsSel} {    
  233.             append text "${sel}[htmlCloseElem LI]"
  234.             set currpos [expr [getPos] + [string length $text]]
  235.         } else {
  236.             set currpos [expr [getPos] + [string length $text]]
  237.             append text [htmlCloseElem LI]
  238.         }
  239.         for {set i 1} {$i < $items} {incr i} {
  240.             append text "\r"
  241.             if {$askForLiAttr} {
  242.                 set text1 [htmlOpenElem LI $liattr 0]
  243.             } else {
  244.                 set text1 [htmlSetCase <LI>]
  245.             }
  246.             if {$text1 == ""} {return}
  247.             append text $indent $exind $text1
  248.             if {$i == 1 && $IsSel} {
  249.                 set currpos [expr [getPos] + [string length $text]]
  250.             } elseif {$useTabMarks} {
  251.                 append text "•"
  252.             }
  253.             append text [htmlCloseElem LI]
  254.         }
  255.     } else {
  256.         if {[set text1 [htmlOpenElem $ltype $listattr 0]] == ""} {return}
  257.         append text $text1
  258.         append text "\r"
  259.         if {$askForLiAttr} {
  260.             set text1 [htmlOpenElem LI $liattr 0]
  261.         } else {
  262.             set text1 [htmlSetCase <LI>]
  263.         }
  264.         if {$text1 == ""} {return}
  265.         append text $indent $exind $text1
  266.         if {$IsSel} {        
  267.             append text $sel 
  268.         } 
  269.         set currpos [expr [getPos] + [string length $text]]
  270.         for {set i 1} {$i < $items} {incr i} {
  271.             append text "\r"
  272.             if {$askForLiAttr} {
  273.                 set text1 [htmlOpenElem LI $liattr 0]
  274.             } else {
  275.                 set text1 [htmlSetCase <LI>]
  276.             }
  277.             if {$text1 == ""} {return}
  278.             append text $indent $exind $text1
  279.             if {$useTabMarks} {append text "•"}
  280.         }
  281.     }
  282.     append text "\r$indent[htmlCloseElem $ltype]"
  283.     append text [htmlCloseCR2 $indent [getPos]]
  284.     if {$useTabMarks} {append text "•"}
  285.     if {$IsSel} { deleteSelection }
  286.     
  287.     insertText $text
  288.     goto $currpos
  289. }
  290.  
  291.  
  292. # Add list entry.  If there is a selection, make it the entry.
  293.  
  294. proc htmlBuildListEntry {liattr} {
  295.     global htmlCurSel htmlIsSel HTMLmodeVars
  296.     
  297.     set containers $HTMLmodeVars(lidtAreContainers)
  298.     set useTabMarks $HTMLmodeVars(useTabMarks)
  299.     htmlGetSel
  300.     set sel $htmlCurSel
  301.     set isSel $htmlIsSel
  302.     set indent [htmlFindNextIndent]
  303.     set text [htmlOpenCR $indent]
  304.     if {[set text1 [htmlOpenElem LI $liattr 0]] == ""} {return}
  305.     append text $text1
  306.     if {$isSel} { deleteSelection }
  307.     if {$containers} {
  308.         if {$isSel} { 
  309.             insertText $text "${sel}" [htmlCloseElem LI]
  310.         } else {
  311.             set currpos [expr [getPos] + [string length $text]]
  312.             append text [htmlCloseElem LI]
  313.             if {$useTabMarks} { append text "•"}
  314.             insertText $text
  315.             goto $currpos
  316.         }
  317.     } else {
  318.         insertText $text $sel
  319.     }
  320. }
  321.  
  322. # Make list items from selection.
  323. proc htmlMakeList {} {
  324.     global HTMLmodeVars
  325.     
  326.     set isContainer $HTMLmodeVars(lidtAreContainers)
  327.     
  328.     if {![isSelection]} {
  329.         beep
  330.         message "No selection."
  331.         return
  332.     }
  333.     
  334.     set values [dialog -w 220 -h 130 -t "Make list" 50 10 210 30 \
  335.     -t "Each item begins with:" 10 40 160 55 -e "*" 170 40 200 55 \
  336.     -t "List:" 10 65 50 85 -m {UL UL OL DIR MENU None} 55 65 200 85 \
  337.     -b OK 20 100 85 120 -b Cancel 105 100 170 120]
  338.     
  339.     if {[lindex $values 3]} {return}
  340.     set itemStr [string trim [lindex $values 0]]
  341.     set listtype [lindex $values 1]
  342.     
  343.     if {![string length $itemStr]} {
  344.         beep
  345.         message "You must give a string which each item begins with."
  346.         return
  347.     }
  348.     set startPos [getPos]
  349.     set endPos [selEnd]
  350.     if {[catch {search -s -f 1 -i 0 -r 0 -m 0 -- $itemStr $startPos} res] || \
  351.     [lindex $res 1] > $endPos} {
  352.         beep 
  353.         message "No list item in selection."
  354.         return
  355.     }
  356.     # Check that the selections begins with a list item.
  357.     set preText [getText $startPos [lindex $res 0]]
  358.     if {![htmlIsWhite $preText]} {
  359.         beep
  360.         message "There is some text before the first list item."
  361.         return
  362.     }
  363.     set indent [htmlFindNextIndent]
  364.     set liIndent $indent
  365.     if {$listtype != "None" && $HTMLmodeVars(indent${listtype})} {append liIndent \t}
  366.     if {$listtype != "None"} {
  367.         set text "[htmlOpenCR $indent 1]"
  368.         if {[string index $text 0] == "\r"} {set text "${liIndent}$text"}
  369.         append text "<[htmlSetCase $listtype]>\r"
  370.     } else {
  371.         set text ""
  372.         set preInd [htmlOpenCR $indent]
  373.         if {[regexp "\r" $preInd]} {set text $preInd}
  374.     }
  375.     # Get each list item.
  376.     set startPos [lindex $res 1]
  377.     while {![catch {search -s -f 1 -i 0 -r 0 -m 0 -- $itemStr $startPos} res2] && \
  378.     [lindex $res2 1] <= $endPos} {
  379.         set text2 [string trim [getText $startPos [lindex $res2 0]]]
  380.         if {$listtype != "None" && $HTMLmodeVars(indent${listtype})} {regsub -all "\r" $text2 "\r\t" text2}
  381.         append text "$liIndent<[htmlSetCase LI]>$text2"
  382.         if {$isContainer} {append text [htmlCloseElem LI]}
  383.         append text "\r"
  384.         set startPos [lindex $res2 1]
  385.     }
  386.     set text2 [string trim [getText $startPos $endPos]]
  387.     if {$listtype != "None" && $HTMLmodeVars(indent${listtype})} {regsub -all "\r" $text2 "\r\t" text2}
  388.     append text "$liIndent<[htmlSetCase LI]>$text2"
  389.     if {$isContainer} {append text [htmlCloseElem LI]}
  390.     append text "\r"
  391.     if {$listtype != "None"} {append text $indent [htmlCloseElem $listtype] [htmlCloseCR2 $indent [selEnd]]}
  392.     replaceText [getPos] [selEnd] $text
  393. }
  394.  
  395.  
  396. # Discursive Lists (term and description elems)
  397. #
  398. # The selection becomes the *description* (*not* the term)
  399.  
  400. # Build a discursive list
  401. proc htmlDiscursive {} {
  402.     global htmlCurSel
  403.     global htmlIsSel
  404.     global HTMLmodeVars 
  405.     
  406.     set containers $HTMLmodeVars(lidtAreContainers)
  407.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  408.     
  409.     set listStr [htmlListQuestions DL DT "DT and DD"]
  410.     if {![llength $listStr]} {
  411.         return
  412.     } else {
  413.         set dlEntries [lindex $listStr 0]
  414.         set askForLiAttr [lindex $listStr 1]
  415.     }
  416.     if {$askForLiAttr} {
  417.         set openDD {htmlOpenElem DD "" 0}
  418.         set openDT {htmlOpenElem DT "" 0}
  419.     } else {
  420.         set openDD {htmlSetCase <DD>}
  421.         set openDT {htmlSetCase <DT>}
  422.     }
  423.     
  424.     htmlGetSel
  425.     set Sel $htmlCurSel
  426.     set indent [htmlFindNextIndent]
  427.     set text [htmlOpenCR $indent 1]
  428.     if {$HTMLmodeVars(indentDL)} {
  429.         set exind \t
  430.         regsub -all "\r" $Sel "\r\t" Sel
  431.     }
  432.     
  433.     if {$containers} {
  434.         if {[set text1 "[htmlOpenElem DL "" 0]\r"] == "\r"} {return}
  435.         append text $text1
  436.         # the first entry
  437.         if {[set text1 [eval $openDT]] == ""} {return}
  438.         append text $indent $exind $text1
  439.         set currpos [expr [getPos] + [string length $text]]
  440.         append text "[htmlCloseElem DT]\t"
  441.         if {[set text1 [eval $openDD]] == ""} {return}
  442.         append text $text1
  443.         if {$htmlIsSel} {
  444.             append text $Sel
  445.         } elseif {$useTabMarks} {
  446.             append text "•"
  447.         }
  448.         append text [htmlCloseElem DD]
  449.         # the rest of the entries
  450.         for {set i 1} {$i < $dlEntries} {incr i} {
  451.             append text "\r"
  452.             if {[set text1 [eval $openDT]] == ""} {return}
  453.             append text $indent $exind $text1
  454.             if {$useTabMarks} { append text "•" }
  455.             append text [htmlCloseElem DT] "\t"
  456.             if {[set text1 [eval $openDD]] == ""} {return}
  457.             append text $text1
  458.             if {$useTabMarks} { append text "•" }
  459.             append text [htmlCloseElem DD] 
  460.         }
  461.         
  462.         if {$useTabMarks} {append text "•"}
  463.         
  464.     } else {
  465.         if {[set text1 [htmlOpenElem DL "" 0]] == ""} {return}
  466.         append text $text1
  467.         append text "\r"
  468.  
  469.         # The first entry
  470.         if {[set text1 [eval $openDT]] == ""} {return}
  471.         append text $indent $exind $text1
  472.     
  473.         set currpos [expr [getPos] + [string length $text]]
  474.         append text "\t"
  475.         if {[set text1 [eval $openDD]] == ""} {return}
  476.         append text $text1
  477.     
  478.         if {$htmlIsSel} {
  479.             append text $Sel
  480.         }
  481.         if {$useTabMarks} {append text "•"}        
  482.     
  483.         # Now for the rest of the entries
  484.         for {set i 1} {$i < $dlEntries} {incr i} {
  485.             append text "\r"
  486.             if {[set text1 [eval $openDT]] == ""} {return}
  487.             append text $indent $exind $text1
  488.             
  489.             if {$useTabMarks} {append text "•"}
  490.             append text "\t"
  491.             if {[set text1 [eval $openDD]] == ""} {return}
  492.             append text $text1
  493.         
  494.             if {$useTabMarks} {append text "•"}
  495.         }
  496.     }
  497.     append text "\r$indent[htmlCloseElem DL]"
  498.     append text [htmlCloseCR2 $indent [getPos]]
  499.     if {$useTabMarks} {append text "•"}
  500.     if {$htmlIsSel} { deleteSelection }
  501.     insertText $text
  502.     goto $currpos
  503. }
  504.  
  505. # Add an individual entry to a discursive list
  506. proc htmlNewDiscursiveEntry {} {
  507.     global htmlCurSel htmlIsSel
  508.     global HTMLmodeVars
  509.     # Is in STYLE container?
  510.     if {[htmlIsInContainer STYLE]} {replaceText [getPos] [selEnd] DT; return}
  511.  
  512.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  513.     set containers $HTMLmodeVars(lidtAreContainers)
  514.     
  515.     htmlGetSel
  516.     set Sel $htmlCurSel
  517.     set indent [htmlFindNextIndent]
  518.     set text [htmlOpenCR $indent]
  519.     if {$HTMLmodeVars(indentDL)} {
  520.         set exind \t
  521.         regsub -all "\r" $Sel "\r\t" Sel
  522.     }
  523.  
  524.     if {$containers} {
  525.         if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
  526.         append text $text1
  527.         set currpos [expr [getPos] + [string length $text]]
  528.         append text "[htmlCloseElem DT]\t"
  529.         if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
  530.         append text $text1
  531.         if {$htmlIsSel} {
  532.             append text ${Sel}
  533.         } elseif {$useTabMarks} {append text "•"}
  534.         append text [htmlCloseElem DD]
  535.         if {$useTabMarks} {append text "•"}
  536.         if {$htmlIsSel} { deleteSelection }
  537.         insertText $text [htmlCloseCR $indent]
  538.     } else {
  539.         if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
  540.         append text $text1
  541.         set currpos [expr [getPos] + [string length $text]]
  542.         append text "\t"
  543.         if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
  544.         append text $text1
  545.     
  546.         if {$htmlIsSel} {
  547.             append text $Sel
  548.         }
  549.         if {$useTabMarks} {append text "•"}
  550.         if {$htmlIsSel} { deleteSelection }
  551.         insertText $text [htmlCloseCR $indent]
  552.     }
  553.     goto $currpos
  554. }
  555.  
  556.  
  557. # Different Input fields
  558.  
  559. proc htmlBuildInputElem {inputelem {cr1 0} {cr2 1}} {
  560.     htmlBuildOpening "INPUT TYPE=\"${inputelem}\"" $cr1 $cr2 $inputelem
  561. }
  562.  
  563.  
  564. # Table template. If there is any selection it is put in the first cell.
  565. proc htmlTableTemplate {} {
  566.     global htmlCurSel htmlIsSel HTMLmodeVars
  567.     
  568.     set useTabMarks $HTMLmodeVars(useTabMarks)
  569.     
  570.     set values {"" "" 0 0 0}
  571.     set rows ""
  572.     set cols ""
  573.     set tableOpen "<[htmlSetCase TABLE]>"
  574.     set trOpen "<[htmlSetCase TR]>"
  575.     while {1} {
  576.         
  577.         set box "-t {Table template} 50 10 200 25 \
  578.         -p 50 26 150 27 \
  579.         -t {Number of rows} 10 40 150 55  -e [list [lindex $values 0]] 160 40 180 55 \
  580.         -t {Number of columns} 10 65 150 80 -e [list [lindex $values 1]] 160 65 180 80 \
  581.         -c {Table headers in first row} [lindex $values 2] 10 90 250 112 \
  582.         -c {Table headers in first column} [lindex $values 3] 10 112 250 134 \
  583.         -c {Don't insert TABLE tags} [lindex $values 4] 10 134 250 156 \
  584.         -b OK 20 250 85 270 -b Cancel 105 250 170 270\
  585.         -b {TABLE attributes…} 10 170 150 190 -b {TR attributes…} 10 200 150 220 "
  586.         
  587.         set values [eval [concat dialog -w 230 -h 280 $box]]
  588.         
  589.         # Cancel?
  590.         if {[lindex $values 6] } {return}
  591.         
  592.         set rows [lindex $values 0]
  593.         set cols [lindex $values 1]
  594.         set THrow [lindex $values 2]
  595.         set THcol [lindex $values 3]
  596.         set table [expr ![lindex $values 4]]
  597.         if {[lindex $values 7]} {
  598.             if {!$table} {
  599.                 alertnote "You have chosen not to insert TABLE tags."
  600.             } elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
  601.                 set tableOpen $tmp
  602.             }
  603.             continue
  604.         }
  605.         if {[lindex $values 8]} {
  606.             if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
  607.                 set trOpen $tmp
  608.             }
  609.             continue
  610.         }
  611.         
  612.         
  613.         if {![htmlIsPositiveInteger $rows] || ![htmlIsPositiveInteger $cols] } {
  614.             alertnote "The number of rows and columns must be specified."
  615.         } else {
  616.             break
  617.         }
  618.     }
  619.     
  620.     htmlGetSel
  621.     if {$htmlIsSel} {deleteSelection}
  622.     set indent [htmlFindNextIndent]
  623.     set trIndent $indent
  624.     if {$HTMLmodeVars(indentTABLE) && $table} {append trIndent \t}
  625.     set tdIndent $trIndent
  626.     if {$HTMLmodeVars(indentTR)} {append tdIndent \t}
  627.     set text [htmlOpenCR $indent 1]
  628.     if {$table} {append text "\r" $indent $tableOpen "\r$trIndent"}
  629.     
  630.     for {set i 1} {$i <= $rows} {incr i} {
  631.         if {$i > 1 || $table} {append text "\r$trIndent"}
  632.         append text "$trOpen\r$tdIndent"
  633.         for {set j 1} {$j <= $cols} {incr j} {
  634.             # Put TH in first row or column?
  635.             if {$i == 1 && $THrow || $j == 1 && $THcol} {
  636.                 set cell [htmlSetCase TH]
  637.             } else {
  638.                 set cell [htmlSetCase TD]
  639.             }
  640.             append text "<$cell>"
  641.             if {$i == 1 && $j == 1} {
  642.                 if {$htmlIsSel} {
  643.                     append text $htmlCurSel
  644.                 } else {
  645.                     set curPos [expr [getPos] + [string length $text]]
  646.                 }
  647.             } elseif {$htmlIsSel && ( $i == 1 && $j == 2 || $i == 2 && $cols == 1 )} {
  648.                 set curPos [expr [getPos] + [string length $text]]
  649.             } elseif {$useTabMarks} {
  650.                 append text "•"
  651.             }    
  652.             append text [htmlCloseElem $cell]
  653.         }
  654.         append text "\r$trIndent[htmlCloseElem TR]\r$trIndent"
  655.     }
  656.     if {$table} {append text "\r$indent[htmlCloseElem TABLE][htmlCloseCR2 $indent [getPos]]"}
  657.     if {$useTabMarks && ($rows > 1 || $cols > 1 || !$htmlIsSel)} {append text "•"}
  658.     insertText $text
  659.     goto $curPos
  660. }
  661.  
  662.  
  663. # Take table rows in a selection and remove the TR, TD and TH elements and
  664. # put tabs between the elements.
  665. proc htmlRowstoTabs {} {
  666.     if {![isSelection]} {
  667.         beep
  668.         message "No selection."
  669.         return
  670.     }
  671.     
  672.     set startPos [getPos]
  673.     set endPos [selEnd]
  674.     if {[catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res] || \
  675.     [lindex $res 1] > $endPos} {
  676.         beep 
  677.         message "No table row in selection."
  678.         return
  679.     }
  680.     # Check that the selections begins with a table row.
  681.     set preText [getText $startPos [lindex $res 0]]
  682.     if {![htmlIsWhite $preText]} {
  683.         beep
  684.         message "First part of selection is not in a table row."
  685.         return
  686.     }
  687.     # Extract each table row.
  688.     set startPos [lindex $res 1]
  689.     while {![catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res2] && \
  690.     [lindex $res2 1] <= $endPos} {
  691.         set text2 [getText $startPos [lindex $res2 0]]
  692.         regsub -all "\[\t\r\]+" $text2 " " text2
  693.         append text [string trim $text2] "\r"
  694.         set startPos [lindex $res2 1]
  695.     }
  696.     set text2 [getText $startPos $endPos]
  697.     regsub -all "\[\t\r\]+" $text2 " " text2
  698.     append text [string trim $text2]
  699.     
  700.     # Check that there is nothing after the last table row.
  701.     if {![catch {search -s -f 1 -i 1 -r 1 -m 0 {</TR>} $startPos} res] \
  702.     && [lindex $res 1] <= $endPos} {
  703.         set preText [getText [lindex $res 1] $endPos]
  704.         if {![htmlIsWhite $preText]} {
  705.             beep
  706.             message "Last part of selection not in a table row."
  707.             return
  708.         }
  709.     }
  710.     # Make the transformation.
  711.     foreach ln [split $text "\r"] {
  712.         if {![string length $ln]} continue
  713.         regsub -all {> +<} $ln "><" ln
  714.         regsub -all {<(t|T)(h|H|d|D)([ ]+[^>]*>|>)} $ln "\t" ln
  715.         regsub {    } $ln "" ln
  716.         regsub -all {</(t|T)(h|H|d|D|r|R)>} $ln "" ln
  717.         append out "$ln\r"
  718.     }
  719.     replaceText [getPos] [selEnd] $out
  720. }
  721.  
  722. # Convert tab-delimited format to table rows.
  723. # First row and first coloumn can optionally consist of table headers.
  724. proc htmlImportTable {} {htmlTabstoRows file}
  725.  
  726. proc htmlTabstoRows {{where selection}} {
  727.     global HTMLmodeVars
  728.     
  729.     if {$where == "selection"} {
  730.         if {![isSelection]} {
  731.             beep
  732.             message "No selection."
  733.             return
  734.         }
  735.         set tabtext [string trim [getSelect]]
  736.         set newln "\r"
  737.         set htext "Tabs to Rows"
  738.     } else {
  739.         set fil [getfile "Select file with table."]
  740.         if {![htmlIsTextFile $fil alertnote]} {return}
  741.         set fid [open $fil r]
  742.         set tabtext [string trim [read $fid]]
  743.         close $fid
  744.         if {[regexp {\n} $tabtext]} {
  745.             set newln "\n"
  746.         } else {
  747.             set newln "\r"
  748.         }
  749.         regsub -all "\n\r" $tabtext "\n" tabtext
  750.         set htext "Import table"
  751.     }
  752.     set values {0 0 0 0}
  753.     set tableOpen "<[htmlSetCase TABLE]>"
  754.     set trOpen "<[htmlSetCase TR]>"
  755.     while {1} {
  756.         
  757.         set box "-t [list $htext] 50 10 200 25 \
  758.         -p 50 26 150 27 \
  759.         -c {Table headers in first row} [lindex $values 0] 10 40 250 62 \
  760.         -c {Table headers in first column} [lindex $values 1] 10 62 250 84 \
  761.         -c {Don't insert TABLE tags} [lindex $values 2] 10 84 250 106 \
  762.         -c {Treat multiple tabs as one} [lindex $values 3] 10 106 250 128 \
  763.         -b OK 20 220 85 240 -b Cancel 105 220 170 240\
  764.         -b {TABLE attributes…} 10 140 150 160 -b {TR attributes…} 10 170 150 190 "
  765.         
  766.         set values [eval [concat dialog -w 230 -h 250 $box]]
  767.         
  768.         # Cancel?
  769.         if {[lindex $values 5] } {return}
  770.         
  771.         set THrow [lindex $values 0]
  772.         set THcol [lindex $values 1]
  773.         set table [expr ![lindex $values 2]]
  774.         if {[lindex $values 3]} {
  775.             set tabexp "\t+"
  776.         } else {
  777.             set tabexp \t
  778.         }
  779.         if {[lindex $values 6]} {
  780.             if {!$table} {
  781.                 alertnote "You have chosen not to insert TABLE tags."
  782.             } elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
  783.                 set tableOpen $tmp
  784.             }
  785.             continue
  786.         }
  787.         if {[lindex $values 7]} {
  788.             if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
  789.                 set trOpen $tmp
  790.             }
  791.             continue
  792.         }
  793.         break
  794.     }
  795.             
  796.     set oelem "${trOpen}\r"
  797.     if {$oelem == "\r"} {return}
  798.     
  799.     set trIndent ""
  800.     if {$HTMLmodeVars(indentTABLE) && $table} {append trIndent \t}
  801.     set tdIndent $trIndent
  802.     if {$HTMLmodeVars(indentTR)} {append tdIndent \t}
  803.     
  804.     set out [htmlOpenCR "" 1]
  805.     if {$table} {append out "\r" $tableOpen "\r"}
  806.  
  807.     set i 1
  808.     foreach ln [split $tabtext $newln] {
  809.         if {![string length $ln]} {
  810.             append out "$trIndent$oelem$trIndent[htmlCloseElem TR]\r"
  811.         } else {
  812.             # Should there be headers in the first row?
  813.             if {$i == 1 && $THrow} {
  814.                 set cell TH
  815.             } else {
  816.                 set cell TD
  817.             }
  818.             # Should there be headers in the first column?
  819.             if {$THcol || ($i == 1 && $THrow)} {
  820.                 set fcell TH
  821.             } else {
  822.                 set fcell TD
  823.             }
  824.             regsub -all $tabexp $ln [htmlSetCase "</$cell><$cell>"] ln
  825.             if {$THcol} {
  826.                 regsub {[tT][dDhH]} $ln [htmlSetCase TH] ln
  827.             }
  828.             if {$i > 1 || $table} {append out "$trIndent\r"}
  829.             append out "$trIndent$oelem$tdIndent<[htmlSetCase $fcell]>$ln"
  830.             # Add cell or fcell closing, depending on if there is more than one cell.
  831.             if {![regexp [htmlCloseElem $fcell] $ln]} {
  832.                 append out [htmlCloseElem $fcell]
  833.             } else {
  834.                 append out [htmlCloseElem $cell]
  835.             }
  836.             append out "\r$trIndent[htmlCloseElem TR]\r"
  837.         }
  838.         incr i
  839.     }
  840.     set indent [htmlFindNextIndent]
  841.     if {$table} {
  842.         append out "$trIndent\r[htmlCloseElem TABLE]"
  843.         append out [htmlCloseCR2 "" [selEnd]]
  844.     }
  845.     regsub -all "\r" $out "\r$indent" out
  846.     set out "$indent[string trimright $out \t]"
  847.     if {$where == "selection"} {
  848.         replaceText [getPos] [selEnd] $out
  849.     } else {
  850.         insertText $out
  851.     }
  852. }
  853.  
  854.  
  855. # Converts an NCSA or CERN image map file to a client side image map.
  856. proc htmlConvertNCSAMap {} {htmlConvertMap NCSA}
  857. proc htmlConvertCERNMap {} {htmlConvertMap CERN}
  858.  
  859. proc htmlConvertMap {type} {
  860.     global HTMLmodeVars
  861.     
  862.     if {[catch {getfile "Select the $type image map file."} fil] || ![htmlIsTextFile $fil alertnote] ||
  863.     [catch {open $fil r} fid]} {return}
  864.     set filecont [read $fid]
  865.     close $fid
  866.     if {[regexp {\n} $filecont]} {
  867.         set newln "\n"
  868.     } else {
  869.         set newln "\r"
  870.     }
  871.     set area [html${type}map [split $filecont $newln]]
  872.     set text [lindex $area 2]
  873.     if {![string length $text]} {
  874.         alertnote "No image map found in [file tail $fil]."
  875.         return
  876.     } elseif {[lindex $area 1]} {
  877.         if {[askyesno "Some lines in [file tail $fil] have invalid syntax. They are ignored. Continue?"] == "no"} {return}
  878.     } elseif {[lindex $area 0]} {
  879.         if {[askyesno "Some lines in [file tail $fil] specify a shape not supported. They are ignored. Continue?"] == "no"} {return}
  880.     }
  881.     if {![string length [set map [htmlOpenElem MAP "" 0]]]} {return}
  882.     set aind [set indent [htmlFindNextIndent]]
  883.     if {$HTMLmodeVars(indentMAP)} {append aind \t}
  884.     regsub -all "\r" [string trimright $text] "\r$aind" text
  885.     insertText [htmlOpenCR $indent 1] $map "\r" $aind $text \r $indent [htmlCloseElem MAP] [htmlCloseCR2 $indent [getPos]]
  886. }
  887.  
  888. proc htmlNCSAmap {lines} {
  889.     set notknown 0
  890.     set someinvalid 0
  891.     set area ""
  892.     set defarea ""
  893.     foreach l $lines {
  894.         set invalid 0
  895.         set l [string trim $l]
  896.         # Skip comments and blank lines
  897.         if {[regexp {^#} $l] || ![string length $l]} {continue}
  898.         set shape [string toupper [lindex $l 0]]
  899.         if {[lsearch {RECT CIRCLE POLY DEFAULT} $shape] < 0} {
  900.             set notknown 1
  901.             continue
  902.         }
  903.         set url [lindex $l 1]
  904.         set exp "^\[0-9\]+,\[0-9\]+$"
  905.         if {[regexp $exp $url]} {
  906.             set url ""
  907.             set cind 1
  908.         } else {
  909.             set cind 2
  910.         }
  911.         switch $shape {
  912.             RECT {
  913.                 if {[regexp $exp [lindex $l $cind]] && [regexp $exp [lindex $l [expr $cind + 1]]]} {
  914.                     set coord "[lindex $l $cind],[lindex $l [expr $cind + 1]]"
  915.                 } else {
  916.                     set invalid 1
  917.                 }
  918.             }
  919.             CIRCLE {
  920.                 if {[regexp $exp [lindex $l $cind] cent] && [regexp $exp [lindex $l [expr $cind + 1]] edge]} {
  921.                     regexp {[0-9]+} $cent xc
  922.                     regexp {[0-9]+} $edge xe
  923.                     set coord "$cent,[expr $xe-$xc]"
  924.                 } else {
  925.                     set invalid 1
  926.                 }
  927.             }
  928.             POLY {
  929.                 set coord ""
  930.                 foreach c [lrange $l $cind end] {
  931.                     if {![regexp $exp $c]} {
  932.                         set invalid 1
  933.                         break
  934.                     }
  935.                     append coord "$c,"
  936.                 }
  937.                 set coord [string trimright $coord ,]
  938.             }
  939.         }
  940.         if {!$invalid} {
  941.             if {$shape == "DEFAULT"} {
  942.                 set toapp defarea
  943.             } else {
  944.                 set toapp area
  945.             }
  946.             append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
  947.             if {$shape != "DEFAULT"} {
  948.                 append $toapp " [htmlSetCase COORDS]=\"$coord\""
  949.             }
  950.             if {[string length $url]} {
  951.                 append $toapp " [htmlSetCase HREF]=\"$url\""
  952.             } else {
  953.                 append $toapp " [htmlSetCase NOHREF]"
  954.             }
  955.             append $toapp ">\r"
  956.         } else {
  957.             set someinvalid 1
  958.         }
  959.     }
  960.     append area $defarea
  961.     return [list $notknown $someinvalid $area] 
  962. }
  963.  
  964. proc htmlCERNmap {lines} {
  965.     set notknown 0
  966.     set someinvalid 0
  967.     set area ""
  968.     set defarea ""
  969.     foreach l $lines {
  970.         set invalid 0
  971.         set l [string trim $l]
  972.         # Skip comments and blank lines
  973.         if {[regexp {^#} $l] || ![string length $l]} {continue}
  974.         set shape [string toupper [lindex $l 0]]
  975.         if {![string match RECT* $shape] && ![string match CIRC* $shape] &&
  976.         ![string match POLY* $shape] && ![string match DEFAULT $shape]} {
  977.             set notknown 1
  978.             continue
  979.         }
  980.         set exp "^\\(\[0-9\]+,\[0-9\]+\\)$"
  981.         switch -glob $shape {
  982.             RECT* {
  983.                 set url [lindex $l 3]
  984.                 if {[regexp $exp [lindex $l 1]] && [regexp $exp [lindex $l 2]]} {
  985.                     set coord "[string trimleft [string trimright [lindex $l 1] )] (],[string trimleft [string trimright [lindex $l 2] )] (]"
  986.                     set shape RECT
  987.                 } else {
  988.                     set invalid 1
  989.                 }
  990.             }
  991.             CIRC* {
  992.                 set url [lindex $l 3]
  993.                 if {[regexp $exp [lindex $l 1]] && [regexp {^[0-9]+$} [lindex $l 2]]} {
  994.                     set coord "[string trimleft [string trimright [lindex $l 1] )] (],[lindex $l 2]"
  995.                     set shape CIRCLE
  996.                 } else {
  997.                     set invalid 1
  998.                 }
  999.             }
  1000.             POLY* {
  1001.                 set coord ""
  1002.                 set url [lindex $l [expr [llength $l] - 1]]
  1003.                 if {[regexp $exp $url]} {
  1004.                     set url ""
  1005.                     set cind 1
  1006.                 } else {
  1007.                     set cind 2
  1008.                 }
  1009.                 foreach c [lrange $l 1 [expr [llength $l] - $cind]] {
  1010.                     if {![regexp $exp $c]} {
  1011.                         set invalid 1
  1012.                         break
  1013.                     }
  1014.                     append coord "[string trimleft [string trimright $c )] (],"
  1015.                 }
  1016.                 set coord [string trimright $coord ,]
  1017.                 set shape POLY
  1018.             }
  1019.             DEFAULT {
  1020.                 set url [lindex $l 1]
  1021.             }
  1022.         }
  1023.         if {!$invalid} {
  1024.             if {$shape == "DEFAULT"} {
  1025.                 set toapp defarea
  1026.             } else {
  1027.                 set toapp area
  1028.             }
  1029.             append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
  1030.             if {$shape != "DEFAULT"} {
  1031.                 append $toapp " [htmlSetCase COORDS]=\"$coord\""
  1032.             }
  1033.             if {[string length $url]} {
  1034.                 append $toapp " [htmlSetCase HREF]=\"$url\""
  1035.             } else {
  1036.                 append $toapp " [htmlSetCase NOHREF]"
  1037.             }
  1038.             append $toapp ">\r"
  1039.         } else {
  1040.             set someinvalid 1
  1041.         }
  1042.     }
  1043.     append area $defarea
  1044.     return [list $notknown $someinvalid $area] 
  1045. }
  1046.  
  1047. proc htmlComment {} {
  1048.     global htmlCurSel
  1049.     global htmlIsSel
  1050.     global HTMLmodeVars
  1051.     set comStrs [htmlCommentStrings]
  1052.     htmlGetSel
  1053.     set text "[htmlOpenCR [set indent [htmlFindNextIndent]]][lindex $comStrs 0]$htmlCurSel"
  1054.     if {$htmlIsSel} { deleteSelection }
  1055.     set currpos [expr [getPos] + [string length $text]]
  1056.     append text [lindex $comStrs 1] [htmlCloseCR $indent]
  1057.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  1058.     insertText $text
  1059.     if {!$htmlIsSel}    {
  1060.         goto $currpos
  1061.     }
  1062. }
  1063.  
  1064.  
  1065. #
  1066. # Template for new file: HTML, TITLE, HEAD, BODY or FRAMESET
  1067. # Optionally input BASE, LINK, ISINDEX, META and SCRIPT in HEAD.
  1068. # We do not put in a DOCTYPE line.
  1069. proc htmlNewDocument {} {htmlNewTemplate BODY}
  1070. proc htmlNewDoc.withFrames {} {htmlNewTemplate FRAMESET}
  1071.  
  1072. proc htmlNewTemplate {doctype} {
  1073.     global htmlCurSel htmlIsSel HTMLmodeVars htmlHeadElements1 htmlHeadElements3 htmlPackageToUse
  1074.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  1075.     set footers $HTMLmodeVars(footers)
  1076.     set indentBODY $HTMLmodeVars(indent${doctype})
  1077.     set headelems [set htmlHeadElements$htmlPackageToUse]
  1078.     
  1079.     set bodyText ""
  1080.     # If the window is not empty, either new window or put text in the body.
  1081.     if {![htmlIsEmptyFile]} {
  1082.         set delBox [dialog -w 420 -h 90 -t "Nonempty window. Do you want to open a new window\
  1083.         or put the text in the document's BODY?" 10 10 410 50 \
  1084.         -b "New window" 20 60 120 80 \
  1085.         -b "Put in BODY" 140 60 240 80 -b Cancel 260 60 325 80]
  1086.         if {[lindex $delBox 0]} {
  1087.             new -n Untitled.html
  1088.         } elseif {[lindex $delBox 2]} {
  1089.             return
  1090.         } else {
  1091.             set bodyText "[getText 0 [maxPos]]\r"
  1092.         }
  1093.     } 
  1094.     
  1095.     if {$doctype == "FRAMESET"} {
  1096.         set htxt "New document with frames"
  1097.     } else {
  1098.         set htxt "New document"
  1099.     }
  1100.     if {$indentBODY} {regsub -all "\r" $bodyText "\r\t" bodyText}
  1101.     # Building footer menu.
  1102.     foreach f $footers {
  1103.         lappend foot [file tail $f]
  1104.     }
  1105.     set footmenu {"No footer"}
  1106.     if {[info exists foot]} {
  1107.         set footmenu [concat $footmenu [lsort $foot]]
  1108.     }
  1109.     
  1110.     set docTitle ""
  1111.     set inHead {0 0 ""}
  1112.     foreach elem $headelems {
  1113.         lappend inHead 0
  1114.     }
  1115.     lappend inHead "No footer"
  1116.     while {![string length $docTitle]} {
  1117.         
  1118.         # Construct the dialog box.
  1119.         set box "-t [list $htxt] 100 10 300 25 -p 100 30 250 31 -t {TITLE} 10 40 60 55 \
  1120.         -e [list [lindex $inHead 2]] 70 40 390 55 \
  1121.         -t {Select the elements you want in the document\'s HEAD} 10 70 390 85"
  1122.         set hpos 100
  1123.         set wpos 10
  1124.         set i 3
  1125.         foreach elem $headelems {
  1126.             append box " -c $elem [lindex $inHead $i] $wpos $hpos [expr $wpos + 100] [expr $hpos + 15]"
  1127.             incr wpos 100
  1128.             if {$wpos > 110} {set wpos 10; incr hpos 20}
  1129.             incr i
  1130.         }
  1131.         if {$wpos > 10} {incr hpos 20}
  1132.         incr hpos 10
  1133.         append box " -t Footer 10 $hpos 80 [expr $hpos + 15] \
  1134.         -m [list [concat [list [lindex $inHead $i]] $footmenu]] 90 $hpos 250 [expr $hpos + 15]"
  1135.         incr hpos 30 
  1136.         set inHead [eval [concat dialog -w 400 -h [expr $hpos + 30] \
  1137.         -b OK 20 $hpos 85 [expr $hpos + 20] \
  1138.         -b Cancel 110 $hpos 175 [expr $hpos + 20] $box]]
  1139.         if {[lindex $inHead 1] } {
  1140.             return
  1141.         }
  1142.         set docTitle [string trim [lindex $inHead 2]]
  1143.         if {![string length $docTitle]} {
  1144.             alertnote "A document title is required."
  1145.         }
  1146.     }
  1147.     
  1148.     
  1149.     if {[set text [htmlOpenElem HTML "" 0]] == "" || 
  1150.     [set text1 [htmlOpenElem HEAD "" 0]] == "" ||
  1151.     [set text2 [htmlOpenElem TITLE "" 0]] == ""} {
  1152.         return
  1153.     }
  1154.     set headIndent ""
  1155.     if {$HTMLmodeVars(indentHEAD)} {set headIndent "\t"}
  1156.     set bodyIndent ""
  1157.     if {$indentBODY} {set bodyIndent "\t"}
  1158.     append text "\r\r${text1}\r$headIndent\r"
  1159.     append text "$headIndent${text2}${docTitle}[htmlCloseElem TITLE]\r$headIndent"
  1160.     set hasScript 0
  1161.     set pre(SCRIPT) "//"; set pre(STYLE) "/*"; set post(SCRIPT) ""; set post(STYLE) "*/"
  1162.     for {set i 0} {$i < [llength  $headelems]} {incr i} {
  1163.         if {[lindex $inHead [expr $i + 3]]} {
  1164.             set he [lindex $headelems $i]
  1165.             if {[set text1 [htmlOpenElem $he "" 0]] != ""} {
  1166.                 append text "\r$headIndent${text1}"
  1167.                 if {$he == "SCRIPT" || $he == "STYLE"} {
  1168.                     append text "\r$headIndent<!-- /* Hide content from old browsers */\r$headIndent"
  1169.                     if {!$hasScript} {
  1170.                         set currpos [string length $text]
  1171.                     } elseif {$useTabMarks} {
  1172.                         append text "•"
  1173.                     }
  1174.                     set hasScript 1
  1175.                     append text "\r$headIndent$pre($he) end hiding content from old browsers $post($he) -->\r$headIndent[htmlCloseElem $he]"
  1176.                 }
  1177.             }
  1178.         }
  1179.     }
  1180.     append text "\r$headIndent\r[htmlCloseElem HEAD]\r\r"
  1181.     
  1182.     if {[set text1 [htmlOpenElem $doctype "" 0]] == ""} {
  1183.         return
  1184.     }
  1185.     append text "$text1\r$bodyIndent\r$bodyIndent"
  1186.     append text $bodyText
  1187.     if {!$hasScript} {
  1188.         set currpos [string length $text]
  1189.     } elseif {$useTabMarks} {
  1190.         append text "•"
  1191.     }    
  1192.     
  1193.     # Insert footer.
  1194.     set footval [lindex $inHead [expr [llength $headelems] + 3]]
  1195.     if {$footval != "No footer"} {
  1196.         set footerFile [lindex $footers [lsearch -exact $foot $footval]]
  1197.         if {![catch {readFile $footerFile} footText]} {
  1198.             if {$indentBODY} {regsub -all "\n" "\t$footText" "\r\t" footText}
  1199.             append text "\r$bodyIndent\r$footText"
  1200.         } else {
  1201.             alertnote "Could not read footer, $footerFile"
  1202.         }
  1203.     }
  1204.     append text "\r$bodyIndent\r[htmlCloseElem $doctype]\r\r[htmlCloseElem HTML]"
  1205.     if {![htmlIsEmptyFile]} {deleteText 0 [maxPos]}
  1206.     insertText $text
  1207.  
  1208.     goto $currpos
  1209. }
  1210.  
  1211.  
  1212. #===============================================================================
  1213. # Document index
  1214. #===============================================================================
  1215.  
  1216. proc htmlDocumentIndex {} {
  1217.     global HTMLmodeVars
  1218.     
  1219.     set liIndent ""
  1220.     set indLists $HTMLmodeVars(indentUL)
  1221.     if {$indLists} {set liIndent \t}
  1222.     
  1223.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#DOCINDEX[ \t\r]+[^>]+>} 0} begin] &&
  1224.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#DOCINDEX[ \t\r]+[^>]+>} [lindex $begin 1]} endind] &&
  1225.     [regexp -nocase {TYPE=\"(UL|PRE,[0-9]+)\"} [getText [lindex $begin 0] [lindex $begin 1]] dum type]} {
  1226.         set type [string toupper $type]
  1227.         if {$type != "UL"} {
  1228.             regexp {(PRE),([0-9]+)} $type dum type indent
  1229.             set indStr [string range "                                  " 1 $indent]
  1230.         }
  1231.         set replace 1
  1232.         set mainind [htmlFindNextIndent [lindex $begin 0]]
  1233.     } else {
  1234.         set replace 0
  1235.         set values {0 0 0 3}
  1236.         set mainind [htmlFindNextIndent]
  1237.         while {1} {
  1238.             set box "-t {Document index} 50 10 250 30 -m {[list [lindex $values 2]] PRE UL} 10 40 60 60\
  1239.             -n PRE -t Indent 70 40 120 60 -e [list [lindex $values 3]] 125 40 165 55 \
  1240.             -t characters 170 40 290 60"
  1241.             set values [eval [concat dialog -w 300 -h 105 -b OK 20 75 85 95 -b Cancel 110 75 175 95 $box]]
  1242.             set type [lindex $values 2]
  1243.             if {[lindex $values 1]} {return}
  1244.             if {$type == "PRE"} {
  1245.                 set indent [lindex $values 3]
  1246.                 if {[htmlIsPositiveInteger $indent]} {
  1247.                     set indStr [string range "                                  " 1 $indent]
  1248.                     break
  1249.                 } else {
  1250.                     alertnote "The number of characters to indent must be specified."
  1251.                 }
  1252.             } else {
  1253.                 break
  1254.             }
  1255.         }
  1256.     }
  1257.  
  1258.     set pos 0
  1259.     set exp {<[Hh][1-6][^>]*>}
  1260.     set exp2 {</[Hh][1-6]>}
  1261.     set indLevel 1
  1262.     set headSize 0
  1263.     set toc "\r\r<[htmlSetCase $type]>"
  1264.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  1265.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  1266.         set start [lindex $rs 0]
  1267.         set end [lindex $res 1]
  1268.         set text [getText $start $end]
  1269.         set thisSize [getText [expr $start + 2] [expr $start + 3]]
  1270.         set text2 [getText [lindex $rs 1] [lindex $res 0]]
  1271.         regsub -all "\[\t\r\]+" $text " " text
  1272.         # remove all tags from text
  1273.         set headtext [string trim [htmlTagStrip $text]]
  1274.         # Remove " from text.
  1275.         regsub -all "\"" $headtext "" headtext
  1276.         # Check if there is already an anchor
  1277.         if {[regexp -nocase {<A[ \t\r\n]+[^<>]*NAME=(\"[^\">]+\"|[^ \t\n\r>]+)} $text2 dum anchor]} {
  1278.             set anchor [string trim $anchor \"]
  1279.         } else {
  1280.             # Insert an anchor
  1281.             set anchor [string trim [string range $headtext 0 15]]
  1282.             # Make sure a &xxx; is not chopped.
  1283.             if {[set amp [string last & $anchor]] > [set semi [string last \; $anchor]]} {
  1284.                 set rest [string range $headtext 16 end]
  1285.                 append anchor [string range $rest 0 [string first \; $rest]]
  1286.             }
  1287.             # Is there an <A> tag?
  1288.             if {[regexp -nocase -indices {<A([ \t\r\n]+[^<>]+>|>)} $text2 atag]} {
  1289.                 set text3 " [htmlSetCase NAME]=\"$anchor\""
  1290.                 replaceText [set blah [expr [lindex $rs 1] + [lindex $atag 0] + 2]] $blah $text3
  1291.                 incr end [string length $text3]
  1292.             } else {
  1293.                 set text3 "<[htmlSetCase {A NAME}]=\"$anchor\">$text2[htmlCloseElem A]"
  1294.                 replaceText [lindex $rs 1] [lindex $res 0] $text3
  1295.                 incr end [expr [string length $text3] - [string length $text2]]
  1296.             }
  1297.         }
  1298.         
  1299.         if {!$headSize} {
  1300.             # first header
  1301.             set headSize $thisSize
  1302.         } elseif {$thisSize > $headSize && $headSize} {
  1303.             # new list
  1304.             for {set i $headSize} {$i < $thisSize} {incr i} { 
  1305.                 if {$type == "UL"} {
  1306.                     append toc "\r$liIndent\r$liIndent<[htmlSetCase UL]>"
  1307.                     if {$indLists} {append liIndent \t}
  1308.                 }
  1309.             }
  1310.             incr indLevel [expr $thisSize - $headSize]
  1311.             set headSize $thisSize
  1312.         } elseif {$thisSize < $headSize && $indLevel} {
  1313.             # close a list
  1314.             for {set i $thisSize} {$i < $headSize && $indLevel > 1} {incr i} {
  1315.                 if {$type == "UL"} {
  1316.                     if {$indLists} {set liIndent [string range $liIndent 1 end]}
  1317.                     append toc "\r$liIndent[htmlCloseElem UL]\r$liIndent"
  1318.                 }
  1319.                 incr indLevel -1
  1320.             }
  1321.             set headSize $thisSize
  1322.         }
  1323.         if {$type == "UL"} {
  1324.             append toc "\r$liIndent" [htmlSetCase <LI>]
  1325.         } else {
  1326.             append toc \r
  1327.             for {set i 1} {$i < $indLevel} {incr i} {
  1328.                 append toc $indStr
  1329.             }
  1330.         }
  1331.         append toc "[htmlSetCase {<A HREF}]=\"#$anchor\">$headtext[htmlCloseElem A]"
  1332.         set pos $end
  1333.     }
  1334.     if {$type == "UL"} {
  1335.         for {set i $indLevel} {$i > 0} {incr i -1} {
  1336.             if {$indLists} {set liIndent [string range $liIndent 1 end]}
  1337.             append toc "\r$liIndent[htmlCloseElem UL]\r$liIndent"
  1338.         }
  1339.     } else {
  1340.         append toc "\r[htmlCloseElem PRE]\r\r"
  1341.     }
  1342.     if {$replace} {
  1343.         if {$type == "UL"} {
  1344.             regsub -all "\r" $toc "\r$mainind" toc
  1345.         }
  1346.         if {$pos == 0} {set toc ""}
  1347.         # Find list again in case it has moved.
  1348.         set begin [search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#DOCINDEX[ \t\r]+[^>]+>} 0]
  1349.         set endind [search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#DOCINDEX[ \t\r]+[^>]+>} [lindex $begin 1]]
  1350.         replaceText [lindex $begin 1] [lindex $endind 0] [string trimright $toc] \r\r $mainind
  1351.     } else {
  1352.         set tt ""
  1353.         if {$pos == 0} {alertnote "Empty index."; return}
  1354.         if {$type == "PRE"} {
  1355.             set tt ",$indent"
  1356.             set ind ""
  1357.         } else {
  1358.             regsub -all "\r" $toc "\r$mainind" toc
  1359.         }
  1360.         insertText [htmlOpenCR $mainind 1] [htmlSetCase "<!-- #DOCINDEX TYPE=\"$type$tt\" -->"] \
  1361.             [string trimright $toc] \r\r $mainind [htmlSetCase "<!-- /#DOCINDEX -->"] [htmlCloseCR2 $mainind [getPos]]
  1362.     }
  1363. }
  1364.